home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 November / Chip Kasım 2000.iso / prog / share / 11 / setup.exe / %MAINDIR% / DEMOS / CIHTTP / HTTPEXP / http.bas < prev    next >
Encoding:
BASIC Source File  |  2000-09-07  |  5.1 KB  |  151 lines

  1. Attribute VB_Name = "HTTPSystem"
  2. '--------------------------------------------------------
  3. '<Purpose> provides support for a remote HTTP system
  4. '--------------------------------------------------------
  5.  
  6. Option Explicit
  7.  
  8.  
  9. '------------------------------------------------------------
  10. '<Purpose> populates the TreeView with HTTP Servers that
  11. ' are designated to be "reconnected at logon"
  12. '------------------------------------------------------------
  13. Public Sub AddHTTPServers(ThisExplorer As Form, ParentNode As Node)
  14.     Dim DriveImage      As Integer
  15.     Dim InstanceServer  As HTTPServer
  16.     Dim TheseNodes      As Nodes
  17.     Dim WorkingNode     As Node
  18.     Dim NodeKey         As String
  19.     Dim ParentKey       As String
  20.     
  21.     ThisExplorer.MousePointer = vbHourglass
  22.     
  23.     '---- errors can be generated from duplicate keys; ignore
  24.     On Error Resume Next
  25.     
  26.     '---- cache nodes collection
  27.     Set TheseNodes = ThisExplorer.Tree.Nodes
  28.     
  29.     ParentKey = ParentNode.Key & "."
  30.     
  31.     For Each InstanceServer In MapServers.Servers
  32.         NodeKey = ParentKey & InstanceServer.Alias
  33.         
  34.         If (Not IsKeyed(TheseNodes, NodeKey)) Then
  35.             If (InstanceServer.Reconnect = vbChecked) Then
  36.                 '---- add the node to the tree
  37.                 Set WorkingNode = TheseNodes.Add(ParentNode, tvwChild, NodeKey, InstanceServer.Alias, imgHTTPDrive)
  38.                 
  39.                 '---- also create and add attachment
  40.                 Dim ThisAttachment As New Attachment
  41.                 Dim ThisSession As New Session
  42.                 
  43.                 ThisAttachment.NodeType = nodHTTPServer
  44.                 Set ThisSession.ThisServer = InstanceServer
  45.                 Set ThisAttachment.Session = ThisSession
  46.                 Call ThisExplorer.Attachments.Add(ThisAttachment, NodeKey)
  47.                 
  48.                 Set ThisSession = Nothing
  49.                 Set ThisAttachment = Nothing
  50.                                 
  51.                 '---- add searching placeholder
  52.                 Call TheseNodes.Add(WorkingNode, tvwChild, WorkingNode.Key & nodPlaceHolder, nodPlaceHolder, imgPlaceHolder)
  53.             End If
  54.         End If
  55.     Next
  56.     
  57. Cleanup:
  58.     On Error GoTo 0
  59.     
  60.     Set InstanceServer = Nothing
  61.     Set TheseNodes = Nothing
  62.     Set WorkingNode = Nothing
  63.     
  64.     ThisExplorer.MousePointer = vbDefault
  65. End Sub
  66.  
  67. '--------------------------------------------------------
  68. '<Purpose> starts the process of getting HTTP directories
  69. '--------------------------------------------------------
  70. Public Function ListHTTPServer(ThisExplorer As Form, ServerNode As Node) As Boolean
  71.     Dim ThisSession     As Form
  72.     Dim ThisAttachment  As Attachment
  73.     
  74.     On Error GoTo BadSession
  75.     Set ThisAttachment = ThisExplorer.Attachments.Item(ServerNode.Key)
  76.     Set ThisSession = ThisAttachment.Session
  77.     
  78.     '---- create the session and set the callback
  79.     With ThisSession
  80.         .WorkingDir = ThisAttachment.DrivePath
  81.         Call .InitSession
  82.         Set .ServerNode = ServerNode
  83.         Set .ThisExplorer = ThisExplorer
  84.         Set .ThisCallback = New HTTPCallback
  85.         Call .Connect
  86.     End With
  87.     
  88.     ListHTTPServer = True
  89.         
  90. Cleanup:
  91.     On Error GoTo 0
  92.     Set ThisSession = Nothing
  93.     Set ThisAttachment = Nothing
  94.     Exit Function
  95.     
  96. BadSession:
  97.     ListHTTPServer = False
  98.     GoTo Cleanup
  99. End Function
  100.  
  101. '--------------------------------------------------------
  102. '<Purpose> maps an HTTPServer to the Explorer
  103. '--------------------------------------------------------
  104. Public Function MapServer(ThisExplorer As Form) As Boolean
  105.     Dim ParentNode      As Node
  106.     Dim ServerNode      As Node
  107.     Dim TheseNodes      As Nodes
  108.     Dim ThisSession     As New Session
  109.     Dim ServerKey       As String
  110.     
  111.     With MapServers
  112.         Set .ThisExplorer = ThisExplorer
  113.         .Show vbModal
  114.         If (Not .PressedOK) Then GoTo Cleanup
  115.     End With
  116.     
  117.     '---- cache nodes collection
  118.     Set TheseNodes = ThisExplorer.Tree.Nodes
  119.     
  120.     Set ThisSession.ThisServer = MapServers.ThisServer
  121.  
  122.     '---- add the node to the tree
  123.     Set ParentNode = TheseNodes.Item("Root.HTTPServers")
  124.     ServerKey = ParentNode.Key & "." & ThisSession.ThisServer.Alias
  125.     
  126.     '---- may already be in TreeView, if not add it
  127.     If (Not IsKeyed(TheseNodes, ServerKey)) Then
  128.         Set ServerNode = TheseNodes.Add(ParentNode, tvwChild, ServerKey, ThisSession.ThisServer.Alias, imgHTTPDrive)
  129.     
  130.         '---- add searching placeholder
  131.         Call TheseNodes.Add(ServerNode, tvwChild, ServerNode.Key & nodPlaceHolder, nodPlaceHolder, imgPlaceHolder)
  132.         
  133.         '---- also create and add attachment
  134.         Dim ThisAttachment As New Attachment
  135.         ThisAttachment.NodeType = nodHTTPServer
  136.         Set ThisAttachment.Session = ThisSession
  137.         Call ThisExplorer.Attachments.Add(ThisAttachment, ServerKey)
  138.         Set ThisAttachment = Nothing
  139.     
  140.     End If
  141.  
  142. Cleanup:
  143.     Set ParentNode = Nothing
  144.     Set TheseNodes = Nothing
  145.     Set ThisSession = Nothing
  146.     Set ServerNode = Nothing
  147.     
  148. End Function
  149.  
  150.  
  151.